home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / monolith / ISTLA.MAC.f < prev    next >
Encoding:
Text File  |  1989-03-04  |  4.1 KB  |  125 lines

  1.         PROGRAM ISTLA
  2.  
  3.         INTEGER SRCPTH(81),MTRPTH(81),CMTPTH(81),
  4.      +          MSYPTH(81),ATRPTH(81),CIPTH(81),
  5.      +          IODATR,STATUS,IODSRC,IODCMT,IODTRE,IODMSY,IODCI,
  6.      +          NERROR,NWARN
  7.  
  8.         INTEGER GETARG,OPEN,CREATE,YPARSE
  9.         EXTERNAL ZINIT,GETARG,ZQUIT,CLOSE,OPEN,CREATE,ERROR,ZYXZIA,
  10.      +           ZYXOAS,ZYSOUT,ZYTOUT,YPARSE,ZMESS,REMARK
  11.  
  12.         CALL ZINIT
  13.         CALL INISTR
  14.         CALL INISYM
  15.         CALL INITRE
  16.  
  17.         CALL ZMESS('ISTLA - Toolpack Static Analyser, Version 1..2',
  18.      +             1)
  19.  
  20.         IF (GETARG(1,SRCPTH,81).EQ.-100) CALL NAMES(SRCPTH,1)
  21.         IF (GETARG(2,CMTPTH,81).EQ.-100) CALL NAMES(CMTPTH,2)
  22.         IF (GETARG(3,MTRPTH,81).EQ.-100) CALL NAMES(MTRPTH,3)
  23.         IF (GETARG(4,MSYPTH,81).EQ.-100) CALL NAMES(MSYPTH,4)
  24.         IF (GETARG(5,CIPTH,81).EQ.-100) CALL NAMES(CIPTH,5)
  25.         IF (GETARG(6,ATRPTH,81).EQ.-100) CALL NAMES(ATRPTH,6)
  26.  
  27.         IODSRC=OPEN(SRCPTH,0)
  28.         IF (IODSRC.EQ.-1) CALL ERROR('Can''t open source file')
  29.         IODCMT=CREATE(CMTPTH,1)
  30.         IF (IODCMT.EQ.-1) CALL ERROR('Can''t create comment file')
  31.         IODCI=CREATE(CIPTH,1)
  32.         IF (IODCI.EQ.-1) CALL ERROR('Can''t create comment index')
  33.         IODATR=CREATE(ATRPTH,1)
  34.         IF (IODATR.EQ.-1) CALL ERROR('Can''t create attribute file')
  35.  
  36.         IF (YPARSE(IODSRC,IODCMT,-1,IODCI,NERROR,NWARN).EQ.0) THEN
  37.             IF (NERROR+NWARN.EQ.0) THEN
  38.                 STATUS=-2
  39.             ELSE IF (NERROR.EQ.0) THEN
  40.                 STATUS=-1002
  41.             ELSE
  42.                 CALL ZCHOUT('[ISTLA Terminated, ',1)
  43.                 CALL ZPTINT(NERROR,1,1)
  44.                 CALL ZCHOUT(' parse er'//'ror',1)
  45.                 IF (NERROR.GT.1) CALL PUTCH(115,1)
  46.                 CALL ZMESS(']',1)
  47.                 CALL ZQUIT(-1)
  48.             END IF
  49.         ELSE
  50.             CALL ERROR('[ISTLA Fatal Error -- Terminated]')
  51.         END IF
  52.  
  53.         CALL ZYXZIA
  54.  
  55.         CALL ZMESS('[Parsing complete, analysis beginning]',1)
  56.  
  57.         CALL ANALYS(.TRUE.,NERROR,NWARN)
  58.  
  59.         IF (NERROR.GT.0) THEN
  60.             CALL REMARK('[ISTLA Terminated, Errors detected]')
  61.             CALL ZQUIT(-1)
  62.         ELSE
  63.             IODTRE=CREATE(MTRPTH,1)
  64.             IF (IODTRE.EQ.-1) CALL ERROR('Can''t create extended tree')
  65.             CALL ZYTOUT(IODTRE)
  66.             IODMSY=CREATE(MSYPTH,1)
  67.             IF (IODMSY.EQ.-1)
  68.      +          CALL ERROR('Can''t create extended symbol table')
  69.             CALL ZYSOUT(IODMSY)
  70.             CALL ZYXOAS(IODATR)
  71.             IF (NWARN.GT.0) THEN
  72.                 CALL REMARK('[ISTLA Terminated, Warnings produced]')
  73.                 CALL ZQUIT(-1002)
  74.             ELSE
  75.                 CALL REMARK('[ISTLA Normal Termination]')
  76.                 CALL ZQUIT(-2)
  77.             END IF
  78.         END IF
  79.  
  80.         END
  81. C ----------------------------------------------------------------------
  82. C
  83. C       N A M E S   -   Prompt user for filenames
  84. C
  85.  
  86.         SUBROUTINE NAMES(PATH,NUMBER)
  87.         INTEGER PATH(81),NUMBER
  88.  
  89.         INTEGER PROMPT(23,6),I
  90.  
  91.         SAVE PROMPT
  92.  
  93.         INTEGER ZGTCMD
  94.         EXTERNAL ZGTCMD,ZPRMPT,ERROR
  95.  
  96. C "Input source file: "
  97. C "Output comment file: "
  98. C "Output parse tree: "
  99. C "Output symbol table: "
  100. C "Output comment index: "
  101. C "Attribute file: "
  102.  
  103.         DATA (PROMPT(I,1),I=1,20)/73,110,112,117,116,32,115,
  104.      +111,117,114,99,101,32,102,105,108,101,58,32,129/,
  105.      +       (PROMPT(I,2),I=1,22)/79,117,116,112,117,116,32,
  106.      +99,111,109,109,101,110,116,32,102,105,108,101,
  107.      +58,32,129/,
  108.      +       (PROMPT(I,3),I=1,20)/79,117,116,112,117,116,
  109.      +32,112,97,114,115,101,32,116,114,101,101,
  110.      +58,32,129/,
  111.      +       (PROMPT(I,4),I=1,22)/79,117,116,112,117,116,
  112.      +32,115,121,109,98,111,108,32,116,97,98,
  113.      +108,101,58,32,129/,
  114.      +       (PROMPT(I,5),I=1,23)/79,117,116,112,117,116,32,
  115.      +99,111,109,109,101,110,116,32,105,110,100,101,120,
  116.      +58,32,129/,
  117.      +       (PROMPT(I,6),I=1,17)/65,116,116,114,105,98,117,
  118.      +116,101,32,102,105,108,101,58,32,129/
  119.  
  120.         CALL ZPRMPT(PROMPT(1,NUMBER))
  121.         IF (ZGTCMD(PATH,0).EQ.-1)
  122.      +      CALL ERROR('ZGTCMD returned Error status')
  123.  
  124.         END
  125.